Libris Britannia 4/science library(b).zip/science library(b)/DDJMAG/DDJ8802.ZIP/LINDLEY.ZIP/LINDLEY.LS2

Text File | 1980-01-01 | 16KB | 904 lines

{************************************************}
{***                                          ***}
{***       Menu System support procedures     ***}
{***      for the serial protocol analyzer    ***}
{***                 written by               ***}
{***              Craig A. Lindley            ***}
{***                                          ***}
{***    Ver: 2.0     Last update: 08/15/87    ***}
{***                                          ***}
{************************************************}

CONST

 {max # of video attributes - 1}
 AttribMax = 5;

 Attributes: ARRAY[0..AttribMax] OF
 RECORD
    f,              {foreground color}
    b: Integer;     {background color}
 END

 {Attributes are:}
 {Low, High, Rev, LowBlink, HighBlink, RevBlink}

  = ((f:7; b:0) , (f:15;b:0) , (f:0; b:7),
     (f:23;b:0) , (f:31;b:0) , (f:16;b:7));


 {menu display lines relative to screen line 1}
 MenuLine1 = 2;
 MenuLine2 = 3;
 MenuLine3 = 4;
 MenuLine4 = 5;

 {max A tree dimensions}
 level2width = 7;
 level3width = 5;
 level4width = 7;

 home=    #199;    {home key code}
 larrow=  #203;    {left cursor arrow code}
 rarrow=  #205;    {right cursor arrow code}
 endkey=  #207;    {end key code}
 bs=      #08;     {backspace key}
 lf=      #10;     {line feed code}
 cr=      #13;     {carrage return code}
 Esc=     #27;     {escape key code}
 sp=      #32;     {ascii space code}

TYPE

 AttribType  = (Low ,High, Rev, LowBlink,
                HighBlink, RevBlink);

 {data structure for atree menu entry}
 {see text for details}

 menu_entry=
 RECORD
    title:  STRING[10];
     desc:  STRING[40];
    chars:  STRING[8];
    index:  Byte;
    ccode:  Byte;
 END;

tree = ARRAY[0..level2width,
             0..level3width,
             0..level4width]
       OF menu_entry;

VAR

 ExitMenu,
 ExitProgram:      Boolean;

 ind1,ind2,
 ind3,
 selector,
 cmd_code,
 level:            Byte;

 {atree data structure used for nested menus}
 atree:            tree;


{******* Keyboard and Display Procedures ********}

PROCEDURE Beep;

BEGIN

   Sound(1000);
   Pause(1);
   NoSound;

END;


FUNCTION GetKey : Byte;

VAR

 Ch: Char;
 B:  Byte;

 CurrentX,
 CurrentY:  Integer;

BEGIN

  {save cursor position}
  {because we are going to yield}
  {and loose control of display}

  CurrentX := WhereX;
  CurrentY := WhereY;

  {yield until a key is pressed}

  WHILE NOT keypressed DO
      yield ;

  {put the cursor back}
  GoToXY(CurrentX,CurrentY);

  {read the key}
  read(kbd,Ch);

  {see if its an extended key}
  IF (Ch = Esc) AND keypressed THEN
  BEGIN
    {if so read again and mark}
    {as extended by setting MSB}
    read(kbd,Ch);
    B := ord(Ch)+128;
  END
  ELSE
    {in either case B has key code}
    B := ord(Ch);

  GetKey := B;

END;


FUNCTION repl (Count:Integer; ch:Char):FullString;

{replicate a char into a string of}
{specified length}

VAR

 i:               Integer;

BEGIN

   FOR i:=1 TO Count DO repl[i]:=ch;
   repl[0]:=Char(Count);

END;


PROCEDURE WriteString (Stng:FullString;
                       Attrib:AttribType);

BEGIN

   {set the foreground and background}
   {colors and write the string}

   WITH Attributes[ORD(Attrib)] DO
   BEGIN
      TextColor(f);
      TextBackGround(b);
   END;
   write(Stng);

   {go back to low video mode}
   WITH Attributes[ORD(Low)] DO
   BEGIN
      TextColor(f);
      TextBackGround(b);
   END;

END;


PROCEDURE WriteStringAt (Stng:FullString;
                         Attrib:AttribType;
                         X,Y:Integer);

BEGIN

 GoToXY(X,Y);
 WriteString(Stng,Attrib);

END;


{*********** Start of Menu Procedures ***********}

PROCEDURE center (Line,Width:Integer;
                  Outstr:FullString;
                  Attrib:AttribType);

{Center and write string with attribute on a}
{specified line in a given width field}

BEGIN

   GoToXY(1,Line);
   Clreol;
   GoToXY((Width DIV 2)-(length(Outstr) DIV 2),
           Line);
   WriteString(Outstr,Attrib);

END;


PROCEDURE DrawFrame (x,y,width,height:Integer);

VAR

 top,bottom:     Str80;

BEGIN

   top:=   repl(width,Char(205));
   bottom:=repl(width,Char(205));
   WriteStringAt(top,High,x,y);
   WriteStringAt(bottom,High,x,y+height-1);

END;


PROCEDURE DrawMenuFrame;

BEGIN

   DrawFrame(1,1,80,6);
   center(MenuLine1,78,
          ' Serial Protocol Analyzer Menu ',Rev);

END;


PROCEDURE DisplayMenu (ind1,ind2,ind3,level,
                       selector:Byte);

VAR

 tind1,tind2,
 tind3,i:     Integer;
 attrib:      AttribType;
 titlestr:    FullString;

BEGIN
   titlestr:='-- '+
     atree[ind1,ind2,ind3].title+' Selection'+' --';
   center(MenuLine2,78,titlestr,Low);
   GoToXY(1,MenuLine4);
   clreol;
   GoToXY(9,MenuLine3);
   clreol;

   FOR i:= 1 TO atree[ind1,ind2,ind3].index DO
   BEGIN
      CASE level OF
         1: ind1:=i;
         2: ind2:=i;
         3: ind3:=i;
      END;
      IF selector <> i THEN  {item not selected}
          attrib:=Low
      ELSE
      BEGIN
         attrib:=Rev;
         tind1:=ind1;
         tind2:=ind2;
         tind3:=ind3;
      END;
      WriteString(atree[ind1,ind2,ind3].title,
                  attrib);
      write('   '); {spaces to separate items}
   END;
   GoToXY(9,MenuLine4);
   clreol;
   write(atree[tind1,tind2,tind3].desc);

END;


PROCEDURE ProcessCr (VAR ind1,ind2,ind3,level,
                     selector,cmd_code:Byte);

BEGIN
 {assign selector to index as it was picked}
 CASE level OF
    1: ind1:=selector;
    2: ind2:=selector;
    3: ind3:=selector;
 END;
 {if entry is terminal entry}
 IF atree[ind1,ind2,ind3].index = 0 THEN
 BEGIN
    {get associated cmd code}
    cmd_code:=atree[ind1,ind2,ind3].ccode;

    {process depending upon level}
    CASE level OF
       1: ind1:=0;
       2: BEGIN
             ind1:=0;
             ind2:=0;
             ind3:=0;
             level:=1;
          END;
       3: BEGIN
             ind2:=0;
             ind3:=0;
             level:=2;
          END;
    END;
 END
 ELSE
 BEGIN
    {down to next menu level}
    level:=level+1;
 END;
 {select set to 1st item}
 selector:=1;

END;


PROCEDURE ProcessMenu (VAR ind1,ind2,ind3,level,
                       selector,cmd_code:Byte);

VAR

 key:          Char;
 position:     Integer;

BEGIN

   key:=upcase(GetKey);
   CASE key OF
    rarrow: BEGIN
               selector:=selector+1;
               IF selector >
                  length(atree[ind1,ind2,ind3].chars) THEN
                   selector:=1;
            END;

    larrow: BEGIN
               selector:=selector-1;
               IF selector < 1 THEN
                  selector :=
                 length(atree[ind1,ind2,ind3].chars);
            END;

    endkey: selector :=
              length(atree[ind1,ind2,ind3].chars);

      home: selector:=1;

        cr: ProcessCr(ind1,ind2,ind3,level,
                      selector,cmd_code);

       esc: cmd_code := 1;     {force exit}

'A'..'Z','0'..'9'  {1st letter of menu item ?}
          : BEGIN
               position :=
                 pos(key,atree[ind1,ind2,ind3].chars);
               IF position <> 0 THEN
               BEGIN             {is 1st letter}
                  selector:=position;
                  ProcessCr(ind1,ind2,ind3,level,
                            selector,cmd_code);
               END
               ELSE     {is not so beep}
                  Beep;
            END;
      ELSE              {invalid so beep}
          beep;
   END;

END;


{Procedure used to process the operator}
{selected commands}
{Defined in the main program's code}

PROCEDURE ProcessCmd (cmd_code: Byte); FORWARD;


FUNCTION DoMenu : Boolean;

VAR

 Line: Integer;

BEGIN

   {stop update of screen info}
   UpdateScreenStatus := False;

   {clear top 6 display lines}
   FOR Line := 1 TO 6 DO
   BEGIN
      GoToXY(1,Line);
      Clreol;
   END;

   {and 2nd to the last one}
   GoToXY(1,24);
   Clreol;

   DrawMenuFrame;
   {clear the menu exit flag}
   ExitMenu := False;

   {clear the program exit flag}
   ExitProgram := False;

   {selector to 1st item in menu}
   selector:=1;

   {command code initialized to 0 }
   cmd_code:=0;

   {1st tier of heirachy}
   level:=1;

   {root menu array location}
   ind1:=0;
   ind2:=0;
   ind3:=0;

   REPEAT

      DisplayMenu (ind1,ind2,ind3,level,selector);
      ProcessMenu (ind1,ind2,ind3,level,selector,
                   cmd_code);
      ProcessCmd  (cmd_code);
      cmd_code:=0;  {reset code selected last}

   UNTIL ExitMenu;

   {start update of screen info}
   UpdateScreenStatus := True;
   {return flag}
   DoMenu := ExitProgram;

END;


PROCEDURE Init_Menu;

{initialize the menu tree}

BEGIN

   fillchar(atree,sizeof(atree),0);

   WITH atree[0,0,0] DO
   BEGIN
      title:='Main Menu';
      chars:='QPDTFCE';
      index:=7;
   END;

   WITH atree[1,0,0] DO
   BEGIN
      title:='Quit';
      desc:='Exit Analyzer Menus';
      ccode:=1;
   END;

   WITH atree[2,0,0] DO
   BEGIN
      title:='Parameters';
      desc:='Set Serial Parameters';
      chars:='QBSWP';
      index:=5;
   END;

   WITH atree[2,1,0] DO
   BEGIN
      title:='Quit';
      desc:='Exit this submenu';
   END;

   WITH atree[2,2,0] DO
   BEGIN
      title:='Baud Rate';
      desc:='Change Serial Baud Rate';
      chars:='Q361249';
      index:=7;
   END;

   WITH atree[2,2,1] DO
   BEGIN
      title:='Quit';
      desc:='Exit this submenu';
   END;

   WITH atree[2,2,2] DO
   BEGIN
      title:='300';
      ccode:=2;
   END;

   WITH atree[2,2,3] DO
   BEGIN
      title:='600';
      ccode:=3;
   END;

   WITH atree[2,2,4] DO
   BEGIN
      title:='1200';
      ccode:=4;
   END;

   WITH atree[2,2,5] DO
   BEGIN
      title:='2400';
      ccode:=5;
   END;

   WITH atree[2,2,6] DO
   BEGIN
      title:='4800';
      ccode:=6;
   END;

   WITH atree[2,2,7] DO
   BEGIN
      title:='9600';
      ccode:=7;
   END;

   WITH atree[2,3,0] DO
   BEGIN
      title:='Stop Bits';
      desc:='Set Number of Stop Bits';
      chars:='Q12';
      index:=3;
   END;

   WITH atree[2,3,1] DO
   BEGIN
      title:='Quit';
      desc:='Exit this submenu';
   END;

   WITH atree[2,3,2] DO
   BEGIN
      title:='1';
      ccode:=8;
   END;

   WITH atree[2,3,3] DO
   BEGIN
      title:='2';
      ccode:=9;
   END;

   WITH atree[2,4,0] DO
   BEGIN
      title:='Word Len.';
      desc:='Set Bits / Word';
      chars:='Q5678';
      index:=5;
   END;

   WITH atree[2,4,1] DO
   BEGIN
     title:='Quit';
     desc:='Exit this SubMenu';
   END;

   WITH atree[2,4,2] DO
   BEGIN
      title:='5';
      ccode:=10;
   END;

   WITH atree[2,4,3] DO
   BEGIN
      title:='6';
      ccode:=11;
   END;

   WITH atree[2,4,4] DO
   BEGIN
      title:='7';
      ccode:=12;
   END;

   WITH atree[2,4,5] DO
   BEGIN
      title:='8';
      ccode:=13;
   END;

   WITH atree[2,5,0] DO
   BEGIN
      title:='Parity';
      desc:='Set Serial Parity';
      chars:='QOEN';
      index:=4;
   END;

   WITH atree[2,5,1] DO
   BEGIN
      title:='Quit';
      desc:='Exit this SubMenu';
   END;

   WITH atree[2,5,2] DO
   BEGIN
      title:='Odd';
      ccode:=14;
   END;

   WITH atree[2,5,3] DO
   BEGIN
      title:='Even';
      ccode:=15;
   END;

   WITH atree[2,5,4] DO
   BEGIN
      title:='None';
      ccode:=16;
   END;

   WITH atree[3,0,0] DO
   BEGIN
     title:='Display';
     desc:='Select Channels for Display';
     chars:='Q12B';
     index:=4;
   END;

   WITH atree[3,1,0] DO
   BEGIN
      title:='Quit';
      desc:='Exit this SubMenu';
   END;

   WITH atree[3,2,0] DO
   BEGIN
      title:='COM1';
      ccode:=17;
   END;

   WITH atree[3,3,0] DO
   BEGIN
      title:='COM2';
      ccode:=18;
   END;

   WITH atree[3,4,0] DO
   BEGIN
      title:='Both 1 & 2';
      ccode:=19;
   END;

   WITH atree[4,0,0] DO
   BEGIN
      title:='Trigger';
      desc:='Controls Trigger Modes';
      chars:='QCPMS';
      index:=5;
   END;

   WITH atree[4,1,0] DO
   BEGIN
     title:='Quit';
     desc:='Exit this SubMenu';
   END;

   WITH atree[4,2,0] DO
   BEGIN
      title:='Channel';
      desc:='Set Trigger Channel';
      chars:='Q12';
      index:=3;
   END;

   WITH atree[4,2,1] DO
   BEGIN
      title:='Quit';
      desc:='Exit this SubMenu';
   END;

   WITH atree[4,2,2] DO
   BEGIN
      title:='COM1';
      ccode:=20;
   END;

   WITH atree[4,2,3] DO
   BEGIN
      title:='COM2';
      ccode:=21;
   END;

   WITH atree[4,3,0] DO
   BEGIN
      title:='Pattern';
      desc:='Input Pattern for Trigger';
      ccode:=22;
   END;

   WITH atree[4,4,0] DO
   BEGIN
      title:='Mode';
      desc:='Select Trigger Mode';
      chars:='QBAE';
      index:=4;
   END;

   WITH atree[4,4,1] DO
   BEGIN
      title:='Quit';
      desc:='Exit this SubMenu';
   END;

   WITH atree[4,4,2] DO
   BEGIN
      title:='Before';
      desc:='Display Data Before Trigger';
      ccode:=23;
   END;

   WITH atree[4,4,3] DO
   BEGIN
      title:='After';
      desc:='Display Data After Trigger';
      ccode:=24;
   END;

   WITH atree[4,4,4] DO
   BEGIN
      title:='Enable';
      desc:='Enable the Trigger';
      ccode:=25;
   END;

   WITH atree[4,5,0] DO
   BEGIN
      title:='Stop';
      desc:='Stop waiting for Trigger Event';
      ccode:=26;
   END;

   WITH atree[5,0,0] DO
   BEGIN
      title:='Format';
      desc:='Set Display Format';
      chars:='QAHS';
      index:=4;
   END;

   WITH atree[5,1,0] DO
   BEGIN
      title:='Quit';
      desc:='Exit this SubMenu';
   END;

   WITH atree[5,2,0] DO
   BEGIN
      title:='Ascii';
      desc:='Ascii Display Format';
      chars:='QNH';
      index:=3;
   END;

   WITH atree[5,2,1] DO
   BEGIN
      title:='Quit';
      desc:='Exit this SubMenu';
   END;

   WITH atree[5,2,2] DO
   BEGIN
      title:='Normal';
      desc:='Data Only';
      ccode:=27;
   END;

   WITH atree[5,2,3] DO
   BEGIN
      title:='HandShake';
      desc:='Data and HandShake';
      ccode:=28;
   END;

   WITH atree[5,3,0] DO
   BEGIN
      title:='Hex';
      desc:='Hex Display Format';
      chars:='QNH';
      index:=3;
   END;

   WITH atree[5,3,1] DO
   BEGIN
      title:='Quit';
      desc:='Exit this SubMenu';
   END;

   WITH atree[5,3,2] DO
   BEGIN
      title:='Normal';
      desc:='Data Only';
      ccode:=29;
   END;

   WITH atree[5,3,3] DO
   BEGIN
      title:='HandShake';
      desc:='Data and HandShake';
      ccode:=30;
   END;

   WITH atree[5,4,0] DO
   BEGIN
      title:='Spaces';
      desc:='Insert space in data display';
      ccode:=31;
   END;

   WITH atree[6,0,0] DO
   BEGIN
      title:='Control';
      desc:='Alter Analyzer Operation';
      chars:='QASCR';
      index:=5;
   END;

   WITH atree[6,1,0] DO
   BEGIN
      title:='Quit';
      desc:='Exit this SubMenu';
   END;

   WITH atree[6,2,0] DO
   BEGIN
      title:='Acquire';
      desc:='Acquire Data';
      ccode:=32;
   END;

   WITH atree[6,3,0] DO
   BEGIN
      title:='Stop';
      desc:='Stop Data Acquisition';
      ccode:=33;
   END;

   WITH atree[6,4,0] DO
   BEGIN
      title:='Clear';
      desc:='Clear Screen of Data';
      ccode:=34;
   END;

   WITH atree[6,5,0] DO
   BEGIN
      title:='Reset';
      desc:='Reset Analyzer';
      ccode:=35;
   END;

   WITH atree[7,0,0] DO
   BEGIN
      title:='End';
      desc:='End the Analyzer Session';
      ccode:=36;
   END;

END;